; UNIT CLASLIB; {Copyright 1984, Apple Computer, Inc.}

; {changed 02/06/84 1530    %_Method must swap in caller}
; {changed 01/20/84 1530    IUJSR decoded corrected}
; {changed 01/18/84 0732    Fixed BEQ bug in %_CallMethod & renamed it %_MethodCall}
; {changed 01/09/84 2105    Separated from XFER so we can include it in PASLIB
;			        SgPASres: %_CallMethod, %_Super, %GoLisaBug;
;			        SgPASini: %_JmpTo, %_ExitCaller, %_ExitPoppingTo, %_GetA5,
;					  %_NextMethod; %_InsStack
;			    Added an argument to %_ExitPoppingTo}

;=============================================================================================
DEBUGF  .EQU  1		        ; 1 to include $D+ info, 0 to exclude it
;=============================================================================================

        .MACRO HEAD
          .IF DEBUGF
            LINK    A6,#0       ; These two instructions form a slow no-op
            MOVE.L  (SP)+,A6
          .ENDC
        .ENDM

        .MACRO TAIL
          .IF DEBUGF
            UNLK    A6
            RTS
            .ASCII  %1
          .ENDC
        .ENDM


;=============================================================================================
        .SEG    'SgPASres'
;=============================================================================================

        .PROC  %_GoLisabug
        HEAD

; PROCEDURE %_GoLisabug;

        TRAP    #0
        RTS

        TAIL    '%_GOLISA'

;=============================================================================================

        .FUNC   %_GetA5
        HEAD

;
; FUNCTION %_GetA5: LONGINT;	  { returns register A5 }
;
; USES  A0
;
        MOVE.L  (SP)+,A0        ; GET RETURN ADDRESS
        MOVE.L  A5,(SP)	        ; STORE A5 INTO RETURN SLOT
        JMP     (A0)	        ; EASY, HUH?

        TAIL    '%_GETA5 '

;=============================================================================================

        .PROC %_MethodCall
        HEAD

;    PROCEDURE %_MethodCall;	    ; 157 cycles or about 32 microseconds for a regular call

;       uses A0,A1,D0,D1,D2

        MOVE.L  (SP)+,A1        ;08	 A1 := Return Address
        TST.B   (A1)	        ;08	 Swap in caller

        MOVE    #0,D0;	        ;04	 D0 := Level Number (0-origin)
        MOVE.B  (A1)+,D0        ;08
        LSL.W   #2,D0	        ;10	 Change to a byte offset

        MOVE    #0,D1;	        ;04	 D1 := Method Number (1-origin)
        MOVE.B  (A1)+,D1        ;08
        LSL.W   #2,D1	        ;10	 Change to a byte offset

        MOVE.L  A1,-(SP)        ;13	 Return Address := A1 (which has been incremented by 2)

        MOVE.L  4(SP),A0        ;16	 A0 := SELF

.IF DEBUGF
        MOVE.L  A0,D2	        ;04	 MOVEA didn't set condition codes
        BEQ     SELFNIL	        ;08	 Error if NIL (next line fails anyway, but we could give a better msg}
.ENDC

        MOVE.L  (A0),A0	        ;12	 A0 := master pointer of SELF
        MOVE.L  (A0),A0	        ;12	 A0 := slice table pointer of SELF's class

        MOVE.L  $00(A0,D0.W),A0 ;18	 A0 := method table pointer for the desired level
        MOVE.L  -4(A0,D1.W),A0  ;18	 A0 := method address

        JMP     (A0)	        ;08	 Jump to method

SELFNIL DIVS    #0,D0	        ;	 **Temporary** Error report

        TAIL    '%_METHOD'

;=============================================================================================

        .PROC %_SUPER
        HEAD

;    PROCEDURE %_Super;	        ; 199 cycles or about 44 microseconds for SUPERSELF (chain dist = 1)

;       uses A0,A1,D0,D1,D2

        MOVE.L  (SP)+,A1        ;08	 A1 := Return Address

        MOVE    #0,D1	        ;04	 D1 := Method Number (1-origin)
        MOVE.B  1(SP),D1        ;12
        LSL.W   #2,D1	        ;10	 Change to a byte offset

        MOVE    #0,D0	        ;04	 D0 := Level Number (0-origin)
        MOVE.B  (SP)+,D0        ;08	 Increments SP by 2!!
        LSL.W   #2,D0	        ;10	 Change to a byte offset

        MOVE.W  (SP)+,D2        ;08	 Chain distance
        MOVE.L  (SP)+,A0        ;12	 Slice table pointer of this class

        MOVE.L  A1,-(SP)        ;13	 Return Address := A1 (which has not been modified)

        JMP     ENDSUPL	        ;10

SUPLOOP MOVE.L -4(A0),A0        ;16	 A0 := superclass slice table pointer
ENDSUPL DBEQ    D2,SUPLOOP      ;10-14	 Loop until chain distance has been traversed (or end of chain)

        MOVE.L  $00(A0,D0.W),A0 ;18	 A0 := method table pointer for the desired level
        MOVE.L  -4(A0,D1.W),A0  ;18	 A0 := method address

        JMP     (A0)	        ;08	 Jump to method

SELFNIL DIVS #0,D0	        ;	 **Temporary** Error report

        TAIL    '%_SUPER '


;=============================================================================================
        .SEG    'SgPASini'
;=============================================================================================


        .PROC %_JMPTO
        HEAD

;    PROCEDURE %_JmpTo(pc: LONGINT);

;       uses A0

        MOVE.L  (SP)+,A0        ; Pop Return address and ignore it
        MOVE.L  (SP)+,A0        ; Pop pc argument
        JMP (A0)	        ; Jump there

        TAIL    '%_JMPTO '

;=============================================================================================

        .PROC %_EXITCA
        HEAD

;    PROCEDURE %_ExitCaller;    that is, exit the caller of my caller, undoing two LINKs

;       modifies A6,SP

        UNLK    A6
        UNLK    A6
        RTS

        .IF DEBUGF
        .ASCII  '%_EXITCA'
        .ENDC

;=============================================================================================

        .PROC %_EXITPO
        HEAD

;   PROCEDURE %_ExitPoppingTo(newSP: LONGINT);
;		    exit my caller, and cut back the stack of the next frame to newSP

;       uses A0,A1 and modifies A6,SP

        MOVE.L  4(A6),A0        ; A0 := caller's return address
        MOVE.L  4(SP),A1        ; A1 := newSP
        UNLK    A6	        ; pop my caller's stack frame
        MOVE.L  A1,SP	        ; SP := newSP
        JMP     (A0)

        .IF DEBUGF
        .ASCII  '%_EXITPO'
        .ENDC

;=============================================================================================

        .FUNC %_NextMethod
        HEAD

;   FUNCTION  %_NextMethod(VAR pc@12: LONGINT;
;			       VAR impLevelNumber@8, impMethNumber@4: INTEGER
;			       )@16: ProcPtr;

;       uses A0,A1,D0

        MOVE.L  12(SP),A0       ; @PC
        MOVE.L  (A0),A1	        ; PC throughout this routine
        TST.B   (A1)	        ; swap in the code to test

INTRPLP CMP.W   #$4EBA,(A1)     ; test for JSR PC+d
        BEQ     JSR_PC
        CMP.W   #$4EAD,(A1)     ; test for JSR d(A5)
        BEQ     JSR_A5
        CMP.B   #$A0,(A1)       ; test for IUJSR
        BEQ     INTJSR
        CMP.W   #$3F3C,(A1)     ; test for MOVE.W #nn,-(SP)
        BEQ     PSHCON
        DIVS    #0,D0	        ; supposedly impossible

PSHCON  MOVE.W  #0,D0	        ; Clear D0 before loading a byte into it
        MOVE.B  2(A1),D0        ; D0 := the "Hi" of JSR PC+HiLo, i.e., levelNumber
        MOVE.L  8(SP),A0        ; A0 := @levelNumber
        MOVE.W  D0,(A0)	        ; store levelNumber from D0

        MOVE.W  #0,D0	        ; Clear D0 before loading a byte into it
        MOVE.B  3(A1),D0        ; D0 := the "Lo" of JSR PC+HiLo, i.e., methodNumber
        SUB.W   #1,D0	        ; decrement methodNumber (will be re-incremented by FINJSR)
        MOVE.L  4(SP),A0        ; A0 := @methodNumber
        MOVE.W  D0,(A0)	        ; store methodNumber-1 from D0

        ADD.L   #4,A1	        ; increment PC past MOVE
        JMP     INTRPLP

INTJSR  MOVE.L  (A1),D1	        ; D1 := IUJSR xxx
        AND.L   #$FFFFFF,D1     ; D1 := targetLocation
        MOVE.L  D1,A0	        ; A0 := targetLocation

FINJSR  MOVE.L  A0,16(SP)       ; function result := targetLocation

        ADD.L   #4,A1	        ; increment PC past JSR
        MOVE.L  12(SP),A0       ; @PC
        MOVE.L  A1,(A0)	        ; store back incremented PC

        MOVE.L  4(SP),A0        ; A0 := @methodNumber
        ADD.W   #1,(A0)	        ; increment methodNumber

        MOVE.L  (SP)+,A0        ; pop and save return address
        ADD.L   #12,SP	        ; pop and discard arguments
        JMP     (A0)	        ; return

JSR_PC  MOVE.W  2(A1),D0        ; D0 := the "d" of JSR PC+d
        LEA     2(A1,D0.W),A0   ; A0 := targetLocation
        JMP     FINJSR

JSR_A5  MOVE.W  2(A1),D0        ; D0 := the "d" of JSR d(A5)
        LEA     0(A5,D0.W),A0   ; A0 := targetLocation
        JMP     FINJSR

        TAIL    '%_NEXTME'

;=============================================================================================

        .FUNC %_InsStack
        HEAD

;   PROCEDURE %_InsStack(addrToInsertAt, bytesToInsert: LONGINT);
;
;       This routine must be used with extreme care.  It inserts space in the middle of the stack.
;       It adjusts A6, A7, and the static chain, but it can not adjust other pointers that may
;       exist into the moved area; that is the responsibility of the caller.
;       This assumes that at least one static link needs adjustment

;       uses A0,A1,D0,D1,D2; modifies A6,A7 and static chain

        MOVE.L  (SP)+,D2        ; D2 := Return address
        MOVE.L  (SP)+,D1        ; D1 := bytesToInsert: must be even and at least 4
        MOVE.L  (SP)+,D0        ; D0 := addrToInsertAt: must be even

        SUB.L   SP,D0	        ; D0 := how many bytes need to move
        SUB.W   #2,D0	        ; D0.W := how many longs
        LSR.W   #2,D0	        ;	  ... need to move

        MOVE.L  SP,A0	        ; A0 := Old SP
        SUB.L   D1,SP	        ; SP := ultimate SP
        MOVE.L  SP,A1	        ; A1 := ultimate SP

        TST.W   -1024(SP)       ; Make the OS expand the stack if necessary

INSLP   MOVE.L  (A0)+,(A1)+     ; Move the data
        DBF     D0,INSLP

        SUB.L   D1,A6	        ; A6 := ultimate A6
        MOVE.L  A6,A1	        ; A1 := addr of first static link

ADJLP   SUB.L   D1,(A1)	        ; adjust this static link
        MOVE.L  (A1),A1	        ; A1 := addr of next static link
        MOVE.L  (A1),D0	        ; D0 := value of that static link
        CMP.L   A0,D0	        ; If (value of that static link - first unmoved addr)
        BLT     ADJLP	        ;       < 0 then that static link needs adjusting, too

        MOVE.L  D2,A1	        ; A1 := Return address
        JMP     (A1)	        ; Return and Pray

        TAIL    '%_INSSTA'

;=============================================================================================

        .END

